home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / dev / src / wangisrc.lha / wangi / z / DefDTIcon / ADDTI / DDTIPatch.PAS < prev   
Pascal/Delphi Source File  |  1996-10-28  |  3KB  |  143 lines
  1. (*
  2.  * An attempt to patch the default icons to display an icon based on file type.
  3.  * Doomed by it being in Pascal... (and this baby was around longer before that
  4.  * thing in NewIcons ;)
  5.  *)
  6.  
  7. { DDTIPatch ---- ©Lee Kindness }
  8.  
  9. {$F-,I+,R+,S+,V+,M 10,1,4,15}
  10.  
  11. USES Exec, Icon, AmigaDOS, Workbench, Amiga;
  12.  
  13. {$I IDPort.PAS }
  14.  
  15. VAR
  16.     oldptr : LONG;
  17.     
  18. Function DDTIGetDiskObjectNew(name : STRPTR) : pDiskObject; Forward;
  19. Function OldGetDiskObjectNew(name : STRPTR) : pDiskObject; Forward;
  20. Procedure ProcessMessage(IDPort : pMsgPort); Forward;
  21. Procedure Main; Forward;
  22.  
  23. function OldGetDiskObjectNew; ASSEMBLER;
  24. ASM
  25.     move.l    a6,-(sp)
  26.                     {move.l    8(sp),a0}
  27.     move.l    IconBase,a6
  28.     move.l  name,a0
  29.                     {jsr        -$84(a6)}
  30.     move.l  (oldptr),a1
  31.     jsr     (a1)
  32.     move.l    d0,$C(sp)
  33.     move.l    (sp)+,a6
  34.                     {move.l  d0,@result}
  35. END;
  36.  
  37.  
  38.  
  39.  
  40.  
  41. Function DDTIGetDiskObjectNew;
  42.  
  43. VAR
  44.     dobj : pDiskObject;
  45.     loc  : BPTR;
  46.     fib  : pFileInfoBlock;
  47.     
  48. begin
  49.     dobj := NIL;
  50.     { copy A0 to variable }
  51.     ASM
  52.         move.l a0,name
  53.     END;
  54.     
  55.     if name <> NIL then begin
  56.         loc := Lock(name, ACCESS_READ);
  57.         if loc <> NULL then begin
  58.             fib := AllocDosObject(DOS_FIB, NIL);
  59.             if fib <> NIL then begin
  60.                 if Examine(loc, fib) then begin
  61.                     Writeln('FIB : ',fib^.fib_DirEntryType);
  62.                     if fib^.fib_DirEntryType < 0 then begin
  63.                         Writeln('Object : ',PtrToPas(name));
  64.                         Writeln('Lock : ',LONG(loc));
  65.                     end;
  66.                 end;
  67.                 FreeDosObject(DOS_FIB, fib);
  68.             end;
  69.             UnLock(loc);
  70.         end;
  71.     end;
  72.     if dobj = NIL then begin 
  73.         write('** Result of OldGetDiskObjectNew = ');
  74.         dobj := OldGetDiskObjectNew(name);
  75.         Writeln(LONG(dobj));
  76.     end;
  77.         
  78.     DDTIGetDiskObjectNew := dobj;
  79.     { copy result to d0 }
  80.     ASM
  81.         move.l @result,d0
  82.     END;
  83. end;
  84.  
  85. Procedure ProcessMessage;
  86.  
  87. VAR 
  88.     Disable : Boolean;
  89.     IDSig, sigrcvd, BitFlags : LONG;
  90.     Finished : Boolean;
  91.     mes : pMessage;
  92.     
  93. begin
  94.     finished := false;
  95.     
  96.     IDSig := 1 shl IDPort^.mp_SigBit;
  97.     
  98.     BitFlags := SIGBREAKF_CTRL_C OR IDSig;
  99.     While Not Finished do begin
  100.         sigrcvd := Wait(BitFlags);
  101.         if ((sigrcvd and IDSig)=IDSig) then begin
  102.             mes := GetMsg(IDPort);
  103.             ReplyMsg(mes);    
  104.             Finished := True;
  105.         end;
  106.         if ((sigrcvd and SIGBREAKF_CTRL_C)=SIGBREAKF_CTRL_C) then begin
  107.             Finished := True;
  108.         end; 
  109.     end;
  110. end;
  111.  
  112.  
  113.  
  114. Procedure Main;
  115. VAR 
  116.     Ok : Boolean;
  117.     IDPort : pMsgPort;
  118.     
  119. CONST
  120.     PortName : String[13] = 'DDTIPatch_ID'#0;
  121.     
  122. begin
  123.     if CheckIDPortOrSetup(IDPort, @portname[1]) then begin
  124.         IconBase := OpenLibrary('icon.library',36);
  125.         if IconBase <> NIL then begin
  126.             oldptr := LONG(SetFunction(IconBase, -$84, @DDTIGetDiskObjectNew));
  127.             
  128.             Writeln('> OldGetDiskObjectNew : ',LONG(@OldGetDiskObjectNew));
  129.             Writeln('> GetDiskObjectNew    : ',LONG(@GetDiskObjectNew));
  130.             Writeln('> Old function        : ',LONG(oldptr));
  131.             
  132.             ProcessMessage(IDPort);
  133.             
  134.             { restore function }
  135.             OldPtr := LONG(SetFunction(IconBase, -$84, Pointer(OldPtr)));
  136.             
  137.             CloseLibrary(IconBase);
  138.         end;
  139.         CleanIDPort(IDPort);
  140.     end;
  141. end;
  142.  
  143. begin main end.